﻿Imports System.Text.RegularExpressions
Imports System.Text
Imports System.Net
Imports System.IO
Imports System.Threading

Public Class mycrawler

    Private urlhash As New Hashtable
    Private conn As OleDb.OleDbConnection
    Private comm As OleDb.OleDbCommand

    Public Sub Initdb()
        Dim dbpath As String = Application.StartupPath + "\" + txtdb.Text
        Dim commstr As String = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbpath & ";Persist Security Info=False" 
        conn = New OleDb.OleDbConnection(commstr)
        comm = New OleDb.OleDbCommand()
        comm.Connection = conn

    End Sub

    Private Function Saveurl(url As String)
        comm.CommandText = "select count(*) from myurl where url='" & url.Trim() & "' "
        If comm.ExecuteScalar() <= 0 Then
            Dim comstr As String = "insert into myurl(url,status,addtime)values('" & url.Trim() & "','0',now())"
            comm.CommandText = comstr
            comm.ExecuteNonQuery()
        End If

    End Function

 



    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click


        Try
            Button1.Enabled = False
            Initdb()
            conn.Open()
            ' Dim websource As String = HttpGet(txturl.Text.Trim, cbCoding.Text.Trim)

            If (txturl.Text.Trim() = String.Empty) Then
                Dim url As String
                url = "http://www.baidu.com/s?wd=$newkey&rn=20"
                Dim encode As String
                encode = System.Web.HttpUtility.UrlEncode(txtkey.Text)
                url = url.Replace("$newkey", encode)
                txturl.Text = url
            End If


            Dim uri As New MyUri(txturl.Text.Trim)
            RegexUrl(uri)
            Application.DoEvents()
            conn.Close()
            MessageBox.Show("下载完成")
            Button1.Enabled = True
        Catch ex As Exception
            MessageBox.Show(ex.Message + ex.StackTrace)
        End Try

    End Sub

    Public urlarray As New Hashtable

    Sub RegexUrl(uri As MyUri)
        Dim webcode As String = HttpGet(uri.ToString, cbCoding.Text.Trim)
        If webcode = "" Then
            Debug.WriteLine("下载出错")
            Return
        End If
        Dim reg As New Regex(txtreg.Text.Trim)
        Dim matches As MatchCollection = reg.Matches(webcode)

        Dim resstr As String = String.Empty '一次结果做为二次目标
        For Each mat As Match In matches
            Dim strRef As String = mat.Value
            resstr = resstr & strRef
        Next


        Dim urlnum As Integer = 0
        Dim temp As String

        If (txt_reg2.Text.Trim = "") Then

            For Each match As Match In matches
                Dim oneurl As String = match.Value
                If (Not urlhash.ContainsKey(oneurl)) Then
                    urlhash.Add(oneurl, oneurl)
                End If
            Next
        Else


            Dim reg2 As New Regex(txt_reg2.Text.Trim)
            Dim mach2 As MatchCollection = reg2.Matches(resstr)


            For Each match As Match In mach2
                Dim oneurl As String = match.Groups("title").Value
                If (Not urlhash.ContainsKey(oneurl)) Then
                    urlhash.Add(oneurl, oneurl)
                End If
            Next

        End If

        For Each entry As DictionaryEntry In urlhash
            temp += entry.Key + Environment.NewLine
            Saveurl(entry.Key)
            urlnum += 1

        Next

        Debug.WriteLine("共" & urlnum & "条记录")
        txtlinks.Text = temp
    End Sub






    Dim queueURLS As New Queue

    Private Function EnqueueUri(ByVal uri As MyUri) As Boolean
        Dim ExtArray As String() = New String() {".gif", ".jpg", ".css", ".zip", ".exe", ".js"}
        For Each ext In ExtArray
            If uri.AbsoluteUri.ToLower.EndsWith(ext) Then
                Return False
            End If
        Next
        If (urlarray.ContainsKey(uri.ToString)) Then
            Return False
        Else
            urlarray.Add(uri.ToString, uri)
        End If

        Debug.WriteLine("enqueue uri is:" + uri.ToString)
        Monitor.Enter(queueURLS)
        Try
            Me.queueURLS.Enqueue(uri)
        Catch exception1 As Exception
        End Try
        Monitor.Exit(queueURLS)
        Return True
    End Function




    Private Function DequeueUri() As MyUri
        Monitor.Enter(Me.queueURLS)
        Dim uri As MyUri = Nothing
        Try
            uri = DirectCast(Me.queueURLS.Dequeue, MyUri)
            Debug.WriteLine("dequeue uri is:" + uri.ToString)
        Catch ex As Exception
            Debug.WriteLine(ex.Message)
        End Try
        Monitor.Exit(Me.queueURLS)
        Return uri
    End Function



    Private Sub ThreadRunFunction()
        Dim uri As MyUri = DequeueUri()
        While (Not uri Is Nothing)
            Thread.Sleep(1000)
            RegexUrl(uri)
            uri = DequeueUri()
        End While

    End Sub




    Private Function HttpGet(ByVal uri As String, coding As String) As String
        Dim response As String = Nothing
        Dim webClient As New WebClient
        Using webClient

            Try
                Dim smr As New StreamReader(webClient.OpenRead(uri), Encoding.GetEncoding(coding))
                Return smr.ReadToEnd


                '处理异常
            Catch ex As WebException
                If TypeOf ex.Response Is HttpWebResponse Then
                    Dim status_cod As HttpStatusCode = DirectCast(ex.Response, HttpWebResponse).StatusCode

                    Select Case status_cod
                        Case HttpStatusCode.Unauthorized
                            response = ""
                        Case HttpStatusCode.NotFound
                            response = ""
                        Case Else
                            Throw ex
                    End Select

                End If


                Return response
            End Try
        End Using

    End Function
    Dim threadParse As Thread
    Private Sub startparse(sender As Object, e As EventArgs) Handles Button2.Click
        Dim fst = New MyUri(txturl.Text.Trim)
        RegexUrl(fst)
        threadParse = New Thread(New ThreadStart(AddressOf Me.ThreadRunFunction))
        threadParse.Start()
    End Sub


End Class